auxiliary/old code/generate_rxode.R

In ahgroup/modelbuilder: Building Compartmental Simulation Models Without Coding

#' Create a rxode simulation model
#'
#' This function takes as input a modelbuilder model and writes code
#' for an ODE simulator implemented with rxode
#'
#' @description The model needs to adhere to the structure specified by the modelbuilder package
#' models built using the modelbuilder package automatically have the right structure
#' a user can also build a model list structure themselves following the specifications
#' if the user provides an Rdata file name, this file needs to contain an object called 'model'
#' and contain a valid modelbuilder model structure
#' @param model model structure, either as list object or Rdata file name
#' @param location a path/folder to save the simulation code to. Default is current directory
#' @return The function does not return anything
#' Instead, it writes an R file into the specified directory
#' this R file contains a rxode implementation of the model
#' the name of the file is simulate_model$title_rxode.R
#' @author Ishaan Dave, Andreas Handel
#' @export

generate_rxode <- function(model, location)
{

  #the name of the function produced by this script is simulate_ + "model title" + "_rxode.R"
  savepath = location #default is current directory for saving the R function

  #the name of the function produced by this script is  "model title" + "_RxODE.R"
  nvars = length(model$var)  #number of variables/compartments in model
  npars = length(model$par)  #number of parameters in model
  ntime = length(model$time) #numer of parameters for time
  modeltitle = gsub(" ","_",model$title) #title for model, replacing space with low dash to be used in function and file names
  #text for model description
  #all this should be provided in the model sctructure
  sdesc=paste0("#' ",model$title,"\n#' \n")
  sdesc=paste0(sdesc,"#' ",model$description,"\n#' \n")
  sdesc=paste0(sdesc,"#' @details ",model$details, "\n")

  for (n in 1:nvars)
  {
    sdesc=paste0(sdesc,"#' \\item ", model$var[[n]]$varname, ' : starting value for ',model$var[[n]]$vartext, "\n")
  }
  sdesc=paste0(sdesc,"#' } \n")
  sdesc=paste0(sdesc,"#' @param pars vector of values for model parameters: \n")
  sdesc=paste0(sdesc,"#' \\itemize{ \n")
  for (n in 1:npars)
  {
    sdesc=paste0(sdesc,"#' \\item ", model$par[[n]]$parname," : ", model$par[[n]]$partext, "\n")
  }
  sdesc=paste0(sdesc,"#' } \n")
  sdesc=paste0(sdesc,"#' @param times vector of values for model times: \n")
  sdesc=paste0(sdesc,"#' \\itemize{ \n")
  for (n in 1:ntime)
  {
    sdesc=paste0(sdesc,"#' \\item ", model$time[[n]]$timename," : ", model$time[[n]]$timetext, "\n")
  }
  sdesc=paste0(sdesc,"#' } \n")
  sdesc=paste0(sdesc,"#' @return The function returns the output as a list. \n")
  sdesc=paste0(sdesc,"#' The time-series from the simulation is returned as a dataframe saved as list element \n")
  sdesc=paste0(sdesc,"#' @examples  \n")
  sdesc=paste0(sdesc,"#' # To run the simulation with default parameters:  \n")
  sdesc=paste0(sdesc,"#' result <- simulate_",modeltitle,"_rxode()", " \n")
  sdesc=paste0(sdesc,"#' @section Warning: ","This function does not perform any error checking. So if you try to do something nonsensical (e.g. have negative values for parameters), the code will likely abort with an error message.", "\n")
  sdesc=paste0(sdesc,"#' @section Model Author: ",model$author, "\n")
  sdesc=paste0(sdesc,"#' @section Model creation date: ",model$date, "\n")
  sdesc=paste0(sdesc,"#' @section Code Author: generated by the \\code{generate_rxode} function \n")
  sdesc=paste0(sdesc,"#' @section Code creation date: ",Sys.Date(), "\n")
  sdesc=paste0(sdesc,"#' @export \n \n")
  ##############################################################################
  #the next block of commands produces the ODE function required by RxODE

  #this creates the lines of code for the main function
  #text for head of main body of function
  varstring = "vars = c("
  varnames = ""
  varnamestring = ""
  varstartvals = ""


  for (n in 1:nvars)
  {
    varstring=paste0(varstring, model$var[[n]]$varname," = ", model$var[[n]]$varval,', ')
    varnamestring=paste0(varnamestring,'"',model$var[[n]]$varname,'",')
    varnames=paste0(varnames,',',model$var[[n]]$varname)
  }

  varnamestring = substr(varnamestring,1,nchar(varnamestring)-1) #trim off final comma
  varstring = substr(varstring,1,nchar(varstring)-2)
  varstring = paste0(varstring,'), ') #close parantheses


  parstring = "pars = c("
  for (n in 1:npars)
  {
    parstring=paste0(parstring, model$par[[n]]$parname," = ", model$par[[n]]$parval,', ')
  }
  parstring = substr(parstring,1,nchar(parstring)-2)
  parstring = paste0(parstring,'), ') #close parantheses

  timestring = "times = c("
  for (n in 1:ntime)
  {
    timestring=paste0(timestring, model$time[[n]]$timename," = ", model$time[[n]]$timeval,', ')
  }
  timestring = substr(timestring,1,nchar(timestring)-2)
  timestring = paste0(timestring,') ') #close parantheses

  ##############################################################################


  stitle = paste0("simulate_",modeltitle,"_RxODE <- function(",varstring, parstring, timestring,') \n{ \n')

  sdisc = "\n "
  sdisc = paste0(sdisc," SIR_model_ode <- \n")
  sdisc = paste0(sdisc,'  \n', '"\n#Start ODE \n')
  for (n in 1:nvars)
  {
    sdisc = paste0(sdisc,' ',"d/dt(",model$var[[n]]$varname,")","=",paste(model$var[[n]]$flows, collapse = ' '), '; \n' )
  }

  sdisc = paste0(sdisc, "#End ODEs \n", '"'," \n \n")



  sdisc = paste0(sdisc,'  times=seq(times[1],times[2],by=times[3]) \n')
  sdisc = paste0(sdisc,'  ev = eventTable() \n')
  sdisc = paste0(sdisc,'  ev$add.sampling(times) \n \n')
  sdisc = paste0(sdisc,'  inits = vars \n \n')
  sdisc = paste0(sdisc,'  mod = RxODE(model = SIR_model_ode, modName = "mod1") \n \n')
  sdisc = paste0(sdisc,'  odeout<- mod$run(pars, ev, inits=inits) \n \n')

  smain = "\n "
  smain = paste0(smain,'  result <- list() \n \n');
  smain = paste0(smain,'  result$ts <- as.data.frame(odeout) \n \n')
  smain = paste0(smain,'  return(result) \n \n')
  smain = paste0(smain,'} \n')
  #finish block that creates main function part
  ##############################################################################

  ##############################################################################
  #write all text blocks to file
  sink(savepath)
  cat(sdesc)
  cat(stitle)
  cat(sdisc)
  cat(smain)
  sink()
}